The World's Largest Collection of Windows Software

home *** CD-ROM | disk | FTP | other *** search

/ The World's Largest Collection of Windows Software / The World's Largest Collection of Windows Software - Disc 1.iso / connect / _b1 / mrun211 / mrun211d.was < prev next >

Wrap

Text File | 1993-05-01 | 23.0 KB | 795 lines

;MailRun v2.11: Part D, adddlfile ;1992-1993 Gerald P. Sully, all rights reserved. #comment ************************************************************************** ************************************************************************** * * This file contains routines related to adding a "Download File" * item to a mailrun. It puts up the Download Files dialog box, * which displays the contents of the available files index (the * *.idx file for the BBS). When a file is selected from the * list, a detailed description is displayed from the *.dbf file * for the BBS). * * The index may be obtained either through the getnewfiles() * procedure, which opens *.QWK files and checks for a newfiles.dat * file, or by importing a list from an external source. In either * case, the file is parsed by the import() procedure. * ************************************************************************** ************************************************************************** #endcomment #define MRUN211D #define MRUN211DE #include "MRUN211.h" string DXFileTabs, BBSidx, BBSdbf, DLPurgeLimit, BBSChoice integer DLSortField #comment ********************************************************************* * * MAIN() * * Calls checkchild(), makebbslist(), makedesc(), * getlastitem(), clearfiledesc(), getnewfiles(), * gettaskstring(), import(), importwarning(), * openfile(), dlfilebox(), deldlfile(), insertitem(), * menudim(), makefullname(), interfaceon(), interfaceoff(), * sortidx(), purgeoldfiles() * * Adds a GetFile item to the mailrun. * ********************************************************************* #endcomment proc main string dlfileString, statstring, ImportFile, ImportFilter, char integer dialogstatus, Perm, j menudim() checkchild() findfirst MailRun MailRunTrunc = $FILENAME ;Set up variables for the dlfilebox DXFileTabs = "58,92,130,305,315,319,322,325,328" strextract BBSChoice TaskItem "`t" 3 strextract char TaskItem "`t" 4 atoi char j profilerd MailRun "MailRun" "DLSortField" DLSortField profilerd MailRun "MailRun" "DLPurgeLimit" DLPurgeLimit makebbslist() FileDesc = makefullname(TempDir, "DESC.TMP") BBSdbf = makefullname(MailRunDir, BBSChoice) strcat BBSdbf ".DBF" BBSidx = makefullname(MailRunDir, BBSChoice) strcat BBSidx ".IDX" ;Update the available files database clearfiledesc() FileName = "" dlfilebox() purgeoldfiles() getnewfiles() updatedlg 16 dialogstatus = $DIALOG while dialogstatus != 1 switch dialogstatus case 10 ;User selected "Add" if not NULLSTR FileName ;only add request if a filename has been entered strupr FileName Perm = 2 - PermRadio strfmt dlfileString "1,%d,GetFile,%s,%s" Perm FileName Conf strfmt statstring \ "Added to %s: `"Download %s from Conference %s`"" \ BBSChoice FileName Conf ;Update MAILRUN.INI, task list j++ insertitem(BBSChoice, j, dlfileString) TaskItem = gettaskstring(BBSChoice, j) statmsg statstring endif endcase case 11 ;User selected "Delete" deldlfile() updatedlg 148 endcase case 12 ;User selected "Import" ;allow the user to abort operation if it will take too long if importwarning() ImportFilter = makefullname(MailRunDir, "*.lst") sdlgfopen "Import File List" ImportFilter ImportFile if SUCCESS ;if the user has selected a file to import... interfaceoff() statmsg "Updating database... 0 files added..." import(ImportFile, 0) sortidx(BBSidx, DLSortField) statmsg "" interfaceon() updatedlg 16 endif endif endcase case 13 ;User selected "Purge" ;Set index and database files to zero length. Set display file ;to a space character. The latter is necessary becuase of an ;ASPECT bug that won't allow update of an ftext box if the ;displayed file is nonexistent or zero length. openfile(BBSidxFile, BBSidx, _CREATE, _NORMAL) openfile(BBSdbfFile, BBSdbf, _CREATE, _NORMAL) fclose BBSidxFile fclose BBSdbfFile clearfiledesc() FileName = "" updatedlg 148 endcase case 50 ;User selected a new sort method if checkfile(BBSidx) profilewr MailRun "MailRun" "DLSortField" DLSortField sortidx(BBSidx, DLSortField) updatedlg 16 endif endcase case 130 ;User selected a file from the index window strextract FileName FileChoice "`t" 0 makedesc(BBSdbf) updatedlg 132 endcase case 170 ;User changed BBS with the combobox j = getlastitem(BBSChoice) TaskItem = gettaskstring(BBSChoice, j) ;Update the available files database BBSdbf = makefullname(MailRunDir, BBSChoice) strcat BBSdbf ".DBF" BBSidx = makefullname(MailRunDir, BBSChoice) strcat BBSidx ".IDX" purgeoldfiles() getnewfiles() clearfiledesc() FileName = "" updatedlg -1 endcase case 230 clearfiledesc() updatedlg 4 endcase endswitch dialogstatus = $DIALOG endwhile profilewr MailRun "MailRun" "DLPurgeLimit" DLPurgeLimit statmsg "" endproc #comment ********************************************************************* * * IMPORTWARNING() * * Called by main() * * If sorting or duplicate filter is set, warns that an * import operation may take a long time. * ********************************************************************* #endcomment func importwarning : integer string WarningMsg integer Response if (DLSortField != 1) && NewfileFilter WarningMsg = "You have chosen to import a list of files with \ the duplicate file filter and sorting enabled. With large file \ lists, this may result in very slow performance.`r`n`r`nDo you \ wish to continue?" elseif DLSortField != 1 WarningMsg = "You have chosen to import a list of files with \ sorting enabled. With large file \ lists, this may result in very slow performance.`r`n`r`nDo you \ wish to continue?" elseif NewfileFilter WarningMsg = "You have chosen to import a list of files with \ the duplicate file filter enabled. With large file \ lists, this may result in very slow performance.`r`n`r`nDo you \ wish to continue?" else return 1 endif sdlgmsgbox "MailRun Message" WarningMsg QUESTION YESNO Response 2 switch Response case 6 return 1 endcase case 7 return 0 endcase endswitch endfunc #comment ********************************************************************* * * PURGEOLDFILES() * * Called by main() * * Calls openfile(), interfaceon(), interfaceoff(), * checkfile(), makefullname() * * Purges aged files from the download database and compresses * the database. The current date is checked against each file * date, and those that are aged are discarded. The number of * days a file can be kept is determined by DLPurgeLimit, which * is set in the Download Files dialog box. * ********************************************************************* #endcomment proc purgeoldfiles string Oldidx, Olddbf, idxString, PurgeMsg string DLFileTrunc, FileSize, FileDate, FDesc, DescBegin, DescLength integer char, count long DLPurgeDays, counter, OldDate, FD, TD, DB, DL, NDB Oldidx = makefullname(TempDir, "oldidx.tmp") Olddbf = makefullname(TempDir, "olddbf.tmp") if !(checkfile(BBSidx) && checkfile(BBSdbf)) return endif findfirst BBSidx strsltime $FDATE "00:00:00" FD strsltime $DATE "00:00:00" TD atol DLPurgeLimit DLPurgeDays if DLPurgeDays && (FD < TD) statmsg "Purging old files... Files in database: 0" interfaceoff() ;save the original dates of the database files so that ;getnewfiles() can function properly getfltime BBSidx OldDate copyfile BBSidx Oldidx copyfile BBSdbf Olddbf openfile(OldidxFile, Oldidx, _READWRITE, _TEXT) openfile(OlddbfFile, Olddbf, _READWRITE, _NORMAL) openfile(BBSidxFile, BBSidx, _CREATE, _TEXT) openfile(BBSdbfFile, BBSdbf _CREATE, _NORMAL) count = 0 fgets OldidxFile idxString while not feof OldidxFile ;loop through the old .idx file strextract FileDate idxString "`t" 2 strsltime FileDate "00:00:00" FD if FD < (TD - (DLPurgeDays * 86400)) ;if the file is older than allowed, discard it fgets OldidxFile idxString loopwhile endif count ++ strfmt PurgeMsg \ "Purging old files... Files in database: %d" count statmsg PurgeMsg strextract DLFileTrunc idxString "`t" 0 strextract FileSize idxString "`t" 1 strextract FDesc idxString "`t" 3 strextract DescBegin idxString "`t" 4 strextract DescLength idxString "`t" 5 atol DescBegin DB atol DescLength DL ftell BBSdbfFile NDB ;go to the beginning of the file description fseek OlddbfFile DB 0 ;copy the description to the new .dbf file for counter = 1 upto DL fgetc OlddbfFile char fputc BBSdbfFile char endfor ;add the index line to the new .idx file fstrfmt BBSidxFile "%s`t%s`t%s`t%s`t%ld`t%ld`r`n" \ DLFileTrunc FileSize FileDate FDesc NDB DL fgets OldidxFile idxString endwhile fclose BBSidxFile fclose BBSdbfFile fclose OldidxFile fclose OlddbfFile delfile Oldidx delfile Olddbf ;restore the original dates of the database files setfltime BBSidx OldDate setfltime BBSdbf OldDate interfaceon() statmsg "" endif endproc #comment ********************************************************************* * * GETNEWFILES() * * Called by main() * * Calls openfile(), interfaceon(), interfaceoff(), checkfile() * makefullname(), import(), sortidx(), findstring() * * Extracts NEWFILES.DAT from a BBS .QWK packet. This is * used to update an index file, BBS.IDX, and a database of * descriptions, BBS.DBF, where "BBS" is the BBS ID. The * first line of each file description in NEWFILES.DAT is * converted to a tab delimited string containing the file's * name, size, date and partial description. The starting * point of the full description in the database and the * length of the description are appended and the entire * string is appended to the index file. Tabstops in the * index flistbox in dlfilebox() allow push the index and * length beyond the right edge of the box. The full * description of each file is appended to the database file. * ********************************************************************* #endcomment proc getnewfiles string QWKFile, NewFiles, MailDir, QWKArchiver string FPCmdLine, MRUnarcBat, Drive integer ArcId, WinId, FirstPass, NumFiles integer i, n long QWKTime, IDXTime profilerd MailRun "MailRun" "MailDir" MailDir profilerd MailRun BBSChoice "QWKArchiver" QWKArchiver QWKFile = makefullname(MailDir, BBSChoice) strcat QWKFile ".QWK" ;Only update the database if there is a more recent ;QWK file for the BBS if isfile QWKFile getfltime QWKFile QWKTime else QWKTime = 0 endif if checkfile(BBSidx) && checkfile(BBSdbf) ;if both database files exist, get their time stamps getfltime BBSidx IDXTime else IDXTime = 0 endif profilerd MailRun "MailRun" "SavePackets" n profilerd MailRun "MailRun" "NewfileFilter" NewfileFilter FirstPass = 1 NumFiles = 0 i = 0 interfaceoff() while (QWKTime > IDXTime) && (i <= n) if FirstPass statmsg "Updating database... 0 files added..." FirstPass = 0 endif ;Set up the unarchive command string and run it. NewFiles = makefullname(TempDir, "NEWFILES.DAT") if isfile NewFiles delfile NewFiles endif if strcmpi QWKArchiver "FPZIPX.EXE" ;if the QWK archiver is FlashPoint ZIP (Windows-based)... strfmt FPCmdLine "fpzipx.exe -e %s %s NEWFILES.DAT" QWKFile TempDir run FPCmdLine MINIMIZED ArcId taskwin ArcId WinId ;stall until execution is finished while !(findstring($TITLEBAR, "FlashPoint")) || (WinId == $ACTIVEWIN) endwhile exittask ArcId else ;otherwise, create a batch file and run it MRUnarcBat = makefullname(TempDir, "MRUnarc.BAT") openfile(MRUnarcFile, MRUnarcBat, _CREATE, _NORMAL) substr Drive TempDir 0 2 fstrfmt MRunarcFile "%s`r`ncd %s`r`n" Drive TempDir switch QWKArchiver case "ARJ.EXE" case "LHA.EXE" case "LHARC.EXE" fstrfmt MRUnarcFile "%s e %s NEWFILES.DAT`r`n" \ QWKArchiver QWKFile endcase case "PKUNZIP.EXE" case "PKXARC.EXE" fstrfmt MRUnarcFile "%s %s NEWFILES.DAT`r`n" \ QWKArchiver QWKFile endcase case "ZOO.EXE" fstrfmt MRUnarcFile "%s -extract NEWFILES.DAT" \ QWKArchiver QWKFile endcase endswitch fclose MRUnarcFile run MRUnarcBat MINIMIZED ArcId ;Stall the script until unzipping is complete while istask ArcId endwhile endif import(NewFiles, &NumFiles) QWKFile = makefullname(MailDir, BBSChoice) strfmt QWKFile "%s.QW%d" QWKFile i if isfile QWKFile getfltime QWKFile QWKTime else QWKTime = 0 endif i++ endwhile if NumFiles sortidx(BBSidx, DLSortField) endif setfltime BBSidx $LTIME setfltime BBSdbf $LTIME interfaceon() statmsg "" endproc #comment ********************************************************************* * * IMPORT() * * Called by main(), getnewfiles() * * Calls openfile(), checkfile(), checknfstring(), findstring() * * Imports a file list into the download files database. * Assumes the format is that appropriate for the BBS type * for the current BBS. * ********************************************************************* #endcomment proc import strparm NewFiles intparm NumFiles string UpdateMsg string NewFileString, NewFileName string FileDate, FileSize, NewFileDate, NewFileSize string idxFile, idxString string Month, Day, Year, ThisYear string dbfString integer MM, DD, YY, TY integer inidx integer NewFileLength long dbfIndex, dbfLength ;make sure the file exists before opening it if isfile NewFiles openfile(NewFilesFile, NewFiles, _READWRITE, _TEXT) if checkfile(BBSidx) && checkfile(BBSdbf) ;If both the index and database files exist, open them openfile(BBSidxFile, BBSidx, _READWRITE, _NORMAL) openfile(BBSdbfFile, BBSdbf, _READWRITE, _NORMAL) else ;If either the index or database file is missing, start from scratch openfile(BBSidxFile, BBSidx, _CREATE, _NORMAL) openfile(BBSdbfFile, BBSdbf, _CREATE, _NORMAL) endif ;Go to the end of the description database fseek BBSdbfFile 0 2 ;Loop through each line of the file list checking for a valid date ;in the position appropriate for the current BBS type. If one is ;found, it can be assumed this is the first line of a file ;description. Files older than 1980 and post-dated files are ;ignored. fgets NewFilesFile NewFileString while not feof NewFilesFile ;loop through the file profilerd MailRun BBSChoice "BBSType" BBSType if findstring(BBSType, "PCBoard") || findstring(BBSType, "RBBS") substr Month NewFileString 23 2 substr Day NewFileString 26 2 substr Year NewFileString 29 2 elseif findstring(BBSType, "WildCat") substr Month NewFileString 24 2 substr Day NewFileString 27 2 substr Year NewFileString 30 2 elseif findstring(BBSType "Auntie") substr Month NewFileString 21 2 substr Day NewFileString 24 2 substr Year NewFileString 27 2 endif atoi Month MM atoi Day DD atoi Year YY ThisYear = $DATE strdelete ThisYear 0 6 atoi ThisYear TY if (MM >= 1 && MM <= 12) && (DD >= 1 && DD <= 31) && \ (YY >= 80 && YY <= TY) ;If there is a valid date in the correct position... ;Put in tab separators strupdt NewFileString "`t" 12 1 if findstring(BBSType, "PCBoard") || findstring(BBSType, "RBBS") strupdt NewFileString "`t" 21 1 strupdt NewFileString "`t" 31 1 elseif findstring(BBSType, "WildCat") strupdt NewFileString "`t" 21 1 strupdt NewFileString "`t" 32 1 strdelete NewFileString 33 1 elseif findstring(BBSType, "Auntie") strupdt NewFileString "`t" 20 1 strupdt NewFileString "`t" 29 1 endif ;Strip extra spaces strfind NewFileString "`t " while FOUND strreplace NewFileString "`t " "`t" strfind NewFileString "`t " endwhile strfind NewFileString " `t" while FOUND strreplace NewFileString " `t" "`t" strfind NewFileString " `t" endwhile if findstring(BBSType, "WildCat") ;remove commas from file size strextract FileSize NewFileString "`t" 1 NewFileSize = FileSize strreplace NewFileSize "," "" strreplace NewFileString FileSize NewFileSize 1 else ;change date format from MM-DD-YY to MM/DD/YY strextract FileDate NewFileSTring "`t" 2 NewFileDate = FileDate strreplace NewFileDate "-" "/" strreplace NewFileString FileDate NewFileDate 1 if strfind BBSType, "Auntie" strextract FileDate NewFileString "`t" 0 NewFileDate = FileDate strreplace NewFileDate " " "." 1 strfind NewFileDate ". " while FOUND strreplace NewFileDate ". " "." strfind NewFileDate ". " endwhile strreplace NewFileString FileDate NewFileDate 1 endif endif strextract NewFileName NewFileString "`t" 0 if NewfileFilter ;If the newfile filter is turned on... inidx = 0 rewind BBSidxFile fgets BBSidxFile idxString while not feof BBSidxFile ;Check the filename against each file in the index strextract idxFile idxString "`t" 0 if strcmpi idxFile NewFileName inidx = 1 exitwhile endif fgets BBSidxFile idxString endwhile if inidx ;If the file is in the index, drop it fgets NewFilesFile NewFileString loopwhile endif endif fseek BBSidxFile 0 2 NumFiles++ strfmt UpdateMsg \ "Updating database... %d files added... %s" \ NumFiles NewFileName statmsg UpdateMsg strlwr NewFileName strlen NewFileName NewFileLength strupdt NewFileString NewFileName 0 NewFileLength ;Append the index ftell BBSdbfFile dbfIndex strfmt NewFileString "%s`t%ld" NewFileString dbfIndex fputs BBSidxFile NewFileString ;Get the first line of the description and put it in ;the database strextract dbfString NewFileString "`t" 3 fputs BBSdbfFile dbfString ;Auntie lists have a blank line before the description if strfind BBSType "Auntie" fgets NewFilesFile NewFileString endif fgets NewFilesFile NewFileString ;Get remaining lines of description while checknfstring(&NewFileString) fstrfmt BBSdbfFile " %s" NewFileString fgets NewFilesFile NewFileString endwhile ;Find the length of the description and append to the index file ftell BBSdbfFile dbfLength dbfLength -= dbfIndex fstrfmt BBSidxFile "`t%ld" dbfLength fputs BBSidxFile "`r`n" else ;If this isn't a file description, get the next line fgets NewFilesFile NewFileString endif endwhile fclose NewFilesFile fclose BBSidxFile fclose BBSdbfFile endif endproc #comment ********************************************************************* * * CHECKNFSTRING() * * Called by import() * * Checks a string for the format appropriate for a * description line. If it is a proper description line * the line is formatted and a value of 1 is returned. * If it is not proper, a value of 0 is returned. * ********************************************************************* #endcomment func checknfstring : integer strparm NewFileString string Blanks integer i if strfind BBSType "PCBoard" strset blanks ' ' 33 if rstrcmp blanks NewFileString 33 strdelete NewFileString 0 33 return 1 endif elseif strfind BBSType "WildCat" strpeek NewFileString 33 i if i == '|' strdelete NewFileString 0 35 return 1 endif elseif strfind BBSType "Auntie" strset blanks ' ' 9 if rstrcmp blanks NewFileString 9 strdelete NewFileString 0 9 return 1 endif endif return 0 endfunc #comment ********************************************************************* * * DELDLFILE() * * Called by main() * * Calls openfile(), interfaceon(), interfaceoff(), * makefullname(), makedesc(), clearfiledesc() * * Deletes a file from the BBS's download index and selects * the next file in the list. * ********************************************************************* #endcomment proc deldlfile string OldBBSidx, idxFile, idxString, temp interfaceoff() OldBBSidx = makefullname(TempDir, "OLIDX.TMP") copyfile BBSidx OldBBSidx openfile(OldidxFile, OldBBSidx, _READWRITE, _TEXT) openfile(BBSidxFile, BBSidx, _CREATE, _TEXT) fgets OldidxFile idxString while not feof OldidxFile strextract idxFile idxString "`t" 0 if strcmpi idxFile FileName exitwhile endif fputs BBSidxFile idxString fgets OldidxFile idxString endwhile fgets OldidxFile idxString FileChoice = idxString while not feof OldidxFile fputs BBSidxFile idxString fgets OldidxFile idxString endwhile if NULLSTR FileChoice fseek BBSidxFile -100 2 fgets BBSidxFile temp while not NULLSTR temp FileChoice = temp fgets BBSidxFile temp endwhile endif fclose BBSidxFile fclose OldidxFile if not NULLSTR FileChoice strextract FileName FileChoice "`t" 0 makedesc(BBSdbf) else clearfiledesc() FileName = "" endif interfaceon() endproc #comment ********************************************************************* * * DLFILEBOX() * * Called by main() * * Displays the Download Files dialog box. * ********************************************************************* #endcomment proc dlfilebox PermRadio = 2 Conf = "0" destroydlg HelpPage = 9 dialogbox 19 38 324 201 15 "Download Files" helpid HelpPage text 12 27 56 8 left "Filename" text 70 27 40 8 left "Size" text 104 27 34 8 left "Date" text 142 27 117 8 left "Description" flistbox 12 38 300 50 BBSidx DXFileTabs single FileChoice groupbox 12 89 300 17 radiobutton 26 94 60 11 "Unsorted" DLSortField radiobutton 91 94 67 11 "Sort by Name" radiobutton 172 94 61 11 "Sort by Size" radiobutton 241 94 62 11 "Sort by Date" endgroup text 13 112 49 8 left "Filename:" editbox 12 122 101 12 FileName text 129 112 67 8 left "Description:" ftext 129 122 182 50 FileDesc text 13 141 56 8 right "Purge files after" text 96 141 16 8 left "days" editbox 74 139 16 12 DLPurgeLimit text 14 158 78 8 right "D/L from Conference:" editbox 96 156 16 12 Conf radiobutton 12 178 53 13 "Permanent" PermRadio radiobutton 70 178 54 13 "Temporary" endgroup pushbutton 130 179 30 14 "&Add" normal default pushbutton 168 179 30 14 "De&lete" normal pushbutton 206 179 30 14 "&Import" normal pushbutton 244 179 30 14 "&Purge" normal pushbutton 282 179 30 14 "&Done" cancel text 76 9 80 8 right "Download File from:" combobox 160 7 70 42 BBSList BBSChoice sort enddialog endproc